indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.3 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 436)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.96754 12.96577 12.96400 12.96224 12.96049 12.95875 12.95702 12.95530
## [9] 12.95359 12.95190 12.95023 12.94857 12.94693 12.94531 12.94371 12.94212
## [17] 12.94057 12.93903 12.93752 12.93604 12.93458 12.93316 12.93176 12.93039
## [25] 12.92906 12.92775 12.92649 12.92525 12.92406 12.92290 12.92178 12.92070
## [33] 12.91966 12.91866 12.91771 12.91680 12.91594 12.91513 12.91436 12.91364
## [41] 12.91298 12.91236 12.91180 12.91130 12.91086 12.91048 12.91016 12.90990
## [49] 12.90970 12.90955 12.90945 12.90940 12.90940 12.90944 12.90953 12.90966
## [57] 12.90983 12.91004 12.91028 12.91055 12.91086 12.91120 12.91156 12.91195
## [65] 12.91237 12.91280 12.91326 12.91373 12.91422 12.91472 12.91523 12.91575
## [73] 12.91628 12.91682 12.91736 12.91790 12.91844 12.91897 12.91951 12.92003
## [81] 12.92055 12.92106 12.92155 12.92203 12.92249 12.92301 12.92365 12.92440
## [89] 12.92525 12.92622 12.92728 12.92844 12.92969 12.93103 12.93244 12.93393
## [97] 12.93549 12.93712 12.93881 12.94055 12.94234 12.94418 12.94606 12.94798
## [105] 12.94992 12.95190 12.95389 12.95590 12.95792 12.95995 12.96198 12.96401
## [113] 12.96603 12.96803 12.97002 12.97199 12.97392 12.97583 12.97769 12.97952
## [121] 12.98129 12.98302 12.98468 12.98629 12.98782 12.98929 12.99067 12.99198
## [129] 12.99320 12.99432 12.99535 12.99628 12.99710 12.99836 13.00054 13.00353
## [137] 13.00724 13.01158 13.01644 13.02174 13.02736 13.03322 13.03921 13.04524
## [145] 13.05122 13.05703 13.06260 13.06781 13.07257 13.07679 13.08036 13.08319
## [153] 13.08518 13.08624 13.08733 13.08946 13.09253 13.09645 13.10115 13.10652
## [161] 13.11250 13.11899 13.12591 13.13317 13.14068 13.14837 13.15614 13.16390
## [169] 13.17158 13.17908 13.18632 13.19322 13.19968 13.20563 13.21097 13.21563
## [177] 13.21951 13.22253 13.22460 13.22564 13.22555 13.22427 13.22212 13.21951
## [185] 13.21646 13.21298 13.20910 13.20482 13.20018 13.19518 13.18985 13.18420
## [193] 13.17825 13.17201 13.16551 13.15876 13.15178 13.14458 13.13719 13.12962
## [201] 13.12189 13.11402 13.10603 13.09792 13.08972 13.08146 13.07313 13.06477
## [209] 13.05639 13.04801 13.03881 13.02806 13.01588 13.00241 12.98777 12.97209
## [217] 12.95551 12.93814 12.92012 12.90157 12.88263 12.86343 12.84408 12.82473
## [225] 12.80550 12.78651 12.76790 12.74980 12.73234 12.71563 12.69982 12.68503
## [233] 12.67139 12.65751 12.64204 12.62514 12.60697 12.58768 12.56743 12.54639
## [241] 12.52471 12.50255 12.48008 12.45744 12.43481 12.41234 12.39019 12.36852
## [249] 12.34748 12.32724 12.30796 12.28980 12.27292 12.25747 12.24273 12.22790
## [257] 12.21300 12.19803 12.18302 12.16797 12.15291 12.13786 12.12283 12.10783
## [265] 12.09288 12.07801 12.06321 12.04852 12.03395 12.01951 12.00523 11.99110
## [273] 11.97717 11.96343 11.94991 11.93662 11.92358 11.91080 11.89831 11.88611
## [281] 11.87434 11.86309 11.85233 11.84203 11.83214 11.82265 11.81351 11.80468
## [289] 11.79615 11.78787 11.77980 11.77192 11.76420 11.75659 11.74907 11.74160
## [297] 11.73415 11.72668 11.71916 11.71156 11.70384 11.69562 11.68661 11.67691
## [305] 11.66662 11.65584 11.64467 11.63321 11.62156 11.60982 11.59810 11.58648
## [313] 11.57508 11.56398 11.55330 11.54314 11.53358 11.52474 11.51672 11.50961
## [321] 11.50351 11.49853 11.49476 11.49231 11.49037 11.48813 11.48566 11.48303
## [329] 11.48031 11.47757 11.47489 11.47233 11.46997 11.46788 11.46612 11.46478
## [337] 11.46392 11.46361 11.46393 11.46495 11.46673 11.46936 11.47289 11.47741
## [345] 11.48298 11.48928 11.49595 11.50297 11.51036 11.51811 11.52623 11.53471
## [353] 11.54356 11.55277 11.56235 11.57230 11.58262 11.59330 11.60435 11.61577
## [361] 11.62756 11.63972 11.65225 11.66516 11.67843 11.69208 11.70610 11.72050
## [369] 11.73527 11.75041 11.76593 11.78183 11.79805 11.81456 11.83136 11.84846
## [377] 11.86588 11.88362 11.90170 11.92011 11.93888 11.95801 11.97752 11.99740
## [385] 12.01768 12.03835 12.05944 12.08095 12.10289 12.12527 12.14810 12.17139
## [393] 12.19515 12.21938 12.24406 12.26914 12.29461 12.32048 12.34674 12.37339
## [401] 12.40044 12.42789 12.45573 12.48396 12.51258 12.54160 12.57101 12.60082
## [409] 12.63101 12.66160 12.69258 12.72395 12.75571 12.78786 12.82040 12.85333
## [417] 12.88665 12.92036 12.95446 12.98895 13.02383 13.05909 13.09474 13.13078
## [425] 13.16721 13.20402 13.24122 13.27881 13.31678 13.35514 13.39389 13.43302
## [433] 13.47253 13.51243 13.55271 13.59338#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 436)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.45796 12.45967 12.46136 12.46305 12.46473 12.46640 12.46808 12.46975
## [9] 12.47142 12.47310 12.47478 12.47646 12.47816 12.47987 12.48159 12.48332
## [17] 12.48507 12.48684 12.48863 12.49044 12.49227 12.49413 12.49602 12.49794
## [25] 12.49989 12.50187 12.50389 12.50595 12.50804 12.51018 12.51236 12.51459
## [33] 12.51686 12.51918 12.52155 12.52398 12.52646 12.52899 12.53159 12.53424
## [41] 12.53696 12.53974 12.54259 12.54550 12.54847 12.55151 12.55460 12.55775
## [49] 12.56095 12.56420 12.56749 12.57083 12.57422 12.57764 12.58111 12.58460
## [57] 12.58814 12.59170 12.59529 12.59891 12.60255 12.60621 12.60989 12.61358
## [65] 12.61729 12.62101 12.62475 12.62848 12.63222 12.63597 12.63971 12.64345
## [73] 12.64718 12.65091 12.65463 12.65833 12.66202 12.66569 12.66934 12.67297
## [81] 12.67657 12.68015 12.68370 12.68722 12.69070 12.69427 12.69804 12.70201
## [89] 12.70617 12.71050 12.71499 12.71964 12.72443 12.72935 12.73439 12.73955
## [97] 12.74481 12.75016 12.75559 12.76109 12.76666 12.77227 12.77792 12.78361
## [105] 12.78931 12.79502 12.80072 12.80642 12.81209 12.81773 12.82333 12.82888
## [113] 12.83436 12.83976 12.84508 12.85031 12.85543 12.86044 12.86532 12.87006
## [121] 12.87466 12.87910 12.88338 12.88747 12.89138 12.89509 12.89859 12.90187
## [129] 12.90544 12.90976 12.91474 12.92031 12.92637 12.93285 12.93966 12.94672
## [137] 12.95394 12.96125 12.96856 12.97578 12.98283 12.98963 12.99610 13.00215
## [145] 13.00770 13.01266 13.01696 13.02051 13.02322 13.02585 13.02915 13.03307
## [153] 13.03754 13.04249 13.04785 13.05357 13.05956 13.06578 13.07215 13.07860
## [161] 13.08507 13.09150 13.09781 13.10395 13.10984 13.11542 13.12063 13.12540
## [169] 13.12966 13.13335 13.13640 13.13875 13.14032 13.14106 13.14089 13.14008
## [177] 13.13892 13.13743 13.13561 13.13348 13.13105 13.12833 13.12532 13.12204
## [185] 13.11850 13.11471 13.11068 13.10643 13.10195 13.09726 13.09238 13.08731
## [193] 13.08206 13.07665 13.07108 13.06537 13.05952 13.05355 13.04747 13.04128
## [201] 13.03500 13.02864 13.02220 13.01571 13.00917 13.00168 12.99246 12.98163
## [209] 12.96932 12.95566 12.94077 12.92480 12.90787 12.89011 12.87165 12.85262
## [217] 12.83315 12.81338 12.79343 12.77343 12.75352 12.73382 12.71447 12.69558
## [225] 12.67731 12.65977 12.64309 12.62741 12.61286 12.59956 12.58765 12.57589
## [233] 12.56304 12.54921 12.53451 12.51905 12.50295 12.48632 12.46927 12.45191
## [241] 12.43436 12.41672 12.39912 12.38165 12.36444 12.34760 12.33123 12.31546
## [249] 12.30039 12.28613 12.27280 12.26051 12.24900 12.23793 12.22725 12.21693
## [257] 12.20694 12.19725 12.18783 12.17864 12.16964 12.16081 12.15212 12.14353
## [265] 12.13500 12.12651 12.11802 12.10949 12.10091 12.09222 12.08341 12.07443
## [273] 12.06526 12.05586 12.04620 12.03674 12.02792 12.01970 12.01202 12.00483
## [281] 11.99806 11.99167 11.98560 11.97980 11.97421 11.96877 11.96344 11.95816
## [289] 11.95286 11.94751 11.94204 11.93640 11.93054 11.92439 11.91791 11.91105
## [297] 11.90368 11.89580 11.88745 11.87869 11.86958 11.86018 11.85055 11.84075
## [305] 11.83083 11.82085 11.81088 11.80097 11.79118 11.78156 11.77218 11.76309
## [313] 11.75436 11.74603 11.73818 11.73086 11.72412 11.71802 11.71263 11.70800
## [321] 11.70419 11.70126 11.69840 11.69483 11.69066 11.68599 11.68093 11.67560
## [329] 11.67008 11.66450 11.65896 11.65356 11.64842 11.64363 11.63931 11.63556
## [337] 11.63249 11.63021 11.62881 11.62842 11.62913 11.63106 11.63430 11.63835
## [345] 11.64261 11.64711 11.65185 11.65683 11.66207 11.66758 11.67335 11.67942
## [353] 11.68577 11.69242 11.69938 11.70666 11.71427 11.72221 11.73050 11.73914
## [361] 11.74814 11.75751 11.76727 11.77741 11.78794 11.79889 11.81014 11.82158
## [369] 11.83324 11.84512 11.85723 11.86958 11.88219 11.89507 11.90822 11.92166
## [377] 11.93540 11.94944 11.96381 11.97851 11.99355 12.00894 12.02470 12.04083
## [385] 12.05735 12.07426 12.09159 12.10933 12.12750 12.14611 12.16517 12.18470
## [393] 12.20462 12.22487 12.24544 12.26634 12.28758 12.30914 12.33104 12.35328
## [401] 12.37586 12.39878 12.42205 12.44566 12.46963 12.49395 12.51862 12.54365
## [409] 12.56903 12.59478 12.62090 12.64737 12.67422 12.70144 12.72903 12.75702
## [417] 12.78542 12.81423 12.84343 12.87303 12.90302 12.93339 12.96414 12.99526
## [425] 13.02674 13.05859 13.09079 13.12334 13.15623 13.18946 13.22303 13.25692
## [433] 13.29113 13.32565 13.36048 13.39562#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 436)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.91823 11.91602 11.91384 11.91170 11.90959 11.90753 11.90550 11.90351
## [9] 11.90157 11.89966 11.89781 11.89599 11.89423 11.89251 11.89084 11.88922
## [17] 11.88765 11.88614 11.88468 11.88327 11.88192 11.88063 11.87940 11.87823
## [25] 11.87712 11.87607 11.87509 11.87417 11.87332 11.87253 11.87182 11.87117
## [33] 11.87060 11.87010 11.86967 11.86932 11.86904 11.86885 11.86873 11.86869
## [41] 11.86873 11.86886 11.86907 11.86936 11.86974 11.87021 11.87076 11.87141
## [49] 11.87215 11.87298 11.87393 11.87501 11.87623 11.87758 11.87905 11.88065
## [57] 11.88235 11.88417 11.88610 11.88813 11.89026 11.89247 11.89478 11.89717
## [65] 11.89965 11.90219 11.90481 11.90749 11.91024 11.91304 11.91590 11.91880
## [73] 11.92174 11.92473 11.92775 11.93080 11.93388 11.93697 11.94008 11.94321
## [81] 11.94634 11.94948 11.95261 11.95574 11.95886 11.96196 11.96505 11.96810
## [89] 11.97114 11.97413 11.97709 11.98001 11.98299 11.98611 11.98937 11.99278
## [97] 11.99632 11.99998 12.00376 12.00766 12.01166 12.01577 12.01997 12.02426
## [105] 12.02864 12.03310 12.03763 12.04222 12.04688 12.05159 12.05634 12.06114
## [113] 12.06598 12.07085 12.07574 12.08065 12.08558 12.09051 12.09544 12.10037
## [121] 12.10528 12.11018 12.11506 12.11991 12.12472 12.12949 12.13421 12.13889
## [129] 12.14350 12.14805 12.15253 12.15693 12.16125 12.16634 12.17298 12.18099
## [137] 12.19023 12.20053 12.21174 12.22371 12.23628 12.24928 12.26257 12.27599
## [145] 12.28938 12.30258 12.31544 12.32780 12.33951 12.35040 12.36033 12.36913
## [153] 12.37665 12.38273 12.38896 12.39695 12.40654 12.41760 12.42998 12.44355
## [161] 12.45817 12.47369 12.48997 12.50687 12.52425 12.54197 12.55988 12.57785
## [169] 12.59574 12.61340 12.63069 12.64748 12.66361 12.67895 12.69336 12.70670
## [177] 12.71882 12.72959 12.73886 12.74649 12.75235 12.75628 12.75865 12.75996
## [185] 12.76025 12.75958 12.75802 12.75560 12.75240 12.74847 12.74385 12.73861
## [193] 12.73280 12.72648 12.71970 12.71252 12.70500 12.69718 12.68913 12.68090
## [201] 12.67255 12.66413 12.65569 12.64730 12.63900 12.63086 12.62293 12.61526
## [209] 12.60792 12.60095 12.59303 12.58293 12.57083 12.55691 12.54136 12.52437
## [217] 12.50611 12.48677 12.46654 12.44560 12.42414 12.40233 12.38036 12.35843
## [225] 12.33670 12.31537 12.29462 12.27464 12.25560 12.23770 12.22111 12.20603
## [233] 12.19263 12.17947 12.16507 12.14955 12.13303 12.11563 12.09748 12.07870
## [241] 12.05940 12.03972 12.01978 11.99969 11.97958 11.95957 11.93979 11.92035
## [249] 11.90139 11.88301 11.86535 11.84852 11.83265 11.81787 11.80348 11.78876
## [257] 11.77375 11.75848 11.74299 11.72732 11.71150 11.69558 11.67960 11.66358
## [265] 11.64758 11.63162 11.61575 11.60000 11.58441 11.56902 11.55388 11.53900
## [273] 11.52445 11.51024 11.49643 11.48304 11.47012 11.45771 11.44584 11.43455
## [281] 11.42377 11.41338 11.40337 11.39372 11.38441 11.37543 11.36677 11.35839
## [289] 11.35030 11.34246 11.33487 11.32751 11.32036 11.31340 11.30663 11.30001
## [297] 11.29353 11.28719 11.28096 11.27482 11.26875 11.26258 11.25615 11.24951
## [305] 11.24271 11.23580 11.22883 11.22185 11.21490 11.20804 11.20131 11.19477
## [313] 11.18846 11.18243 11.17673 11.17141 11.16652 11.16210 11.15822 11.15491
## [321] 11.15222 11.15021 11.14892 11.14840 11.14811 11.14752 11.14670 11.14570
## [329] 11.14460 11.14345 11.14233 11.14129 11.14041 11.13974 11.13935 11.13931
## [337] 11.13967 11.14052 11.14189 11.14388 11.14653 11.14991 11.15409 11.15913
## [345] 11.16509 11.17169 11.17859 11.18580 11.19331 11.20113 11.20925 11.21769
## [353] 11.22645 11.23551 11.24490 11.25460 11.26462 11.27497 11.28564 11.29663
## [361] 11.30796 11.31961 11.33160 11.34392 11.35658 11.36957 11.38291 11.39658
## [369] 11.41060 11.42497 11.43968 11.45474 11.47011 11.48577 11.50171 11.51794
## [377] 11.53447 11.55129 11.56843 11.58588 11.60365 11.62174 11.64016 11.65891
## [385] 11.67800 11.69744 11.71723 11.73737 11.75787 11.77874 11.79999 11.82161
## [393] 11.84361 11.86600 11.88876 11.91185 11.93528 11.95904 11.98314 12.00758
## [401] 12.03235 12.05745 12.08290 12.10867 12.13479 12.16123 12.18801 12.21513
## [409] 12.24257 12.27036 12.29847 12.32692 12.35570 12.38481 12.41426 12.44404
## [417] 12.47415 12.50459 12.53536 12.56646 12.59790 12.62967 12.66176 12.69419
## [425] 12.72695 12.76003 12.79345 12.82720 12.86127 12.89567 12.93041 12.96547
## [433] 13.00086 13.03658 13.07262 13.10900#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log10 SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")